home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / btree.sea / btree / load-btree.lisp / load-btree.lisp
Encoding:
Text File  |  1992-08-12  |  1.3 KB  |  37 lines  |  [TEXT/CCL2]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;; load-btree.lisp
  3. ;;
  4. ;; Copyright © 1992 University of Toronto, Department of Computer Science
  5. ;; All Rights Reserved
  6. ;;
  7. ;; author: Mark A. Tapia markt@dgp.toronto.edu or markt@dgp.utoronto.ca
  8. ;; 
  9. ;; loads the btree package
  10. (defpackage btree
  11.   (:use "COMMON-LISP" "CCL"))
  12.  
  13. (defmacro logical-to-name (logical-name &optional rest)
  14.   "Allow the expansion of logical pathnames"
  15.   `(if ,rest
  16.      (format nil "~a~a" (mac-directory-namestring 
  17.                          (truename ,logical-name))
  18.              ,rest)
  19.      (mac-directory-namestring (truename ,logical-name))))
  20.  
  21. (defun translate-name (top-dir &optional sub-dirs file)
  22.   (let (main-dir)
  23.     (if file
  24.       (setq main-dir (logical-to-name top-dir sub-dirs))
  25.       (setq main-dir (logical-to-name top-dir)
  26.             file sub-dirs))
  27.     (format nil "~a~a"  main-dir file)))
  28.  
  29. (setf (logical-pathname-translations "btree")
  30.       (list (list "btree:**;*.*"
  31.                   (full-pathname
  32.                    (concatenate 'string
  33.                                 (directory-namestring *loading-file-source-file*)
  34.                                 "**:*.*")))))
  35.  
  36. (load (translate-name "btree:" "btree-dcl")  :verbose t)
  37. (load (translate-name "btree:" "btree")      :verbose t)